(DEFPROP %DEFIN
 (LAMBDA (X V F P)
  (PROG (R)
	(SETQ R	(COND ((GETL X %FTYPES) (LIST X (QUOTE REDEFINED)))
		      (T X)))
	(PUTPROP X (LIST (QUOTE LAMBDA) V F) P)
	(RETURN R)))
 EXPR)

(DEFPROP %DEF
 (LAMBDA (ARGS TYPE)
  (COND	((ATOM (CAR ARGS))
	 (%DEFIN (CAR ARGS) (CADR ARGS) (CADDR ARGS) TYPE))
	(T (%DEFIN (CAAR ARGS) (CDAR ARGS) (CADR ARGS) TYPE))))
 EXPR)

(DEFPROP DE (LAMBDA (L) (%DEF L (QUOTE EXPR))) FEXPR)

(DEFPROP DF (LAMBDA (L) (%DEF L (QUOTE FEXPR))) FEXPR)

(DEFPROP DM (LAMBDA (L) (%DEF L (QUOTE MACRO))) FEXPR)

(SETQ %FTYPES (QUOTE (EXPR FEXPR SUBR FSUBR LSUBR MACRO)))

(DEFPROP PLUS (LAMBDA (L) (*EXPAND L (QUOTE *PLUS))) MACRO)

(DEFPROP DIFFERENCE (LAMBDA (L) (*EXPAND L (QUOTE *DIF))) MACRO)

(DEFPROP TIMES (LAMBDA (L) (*EXPAND L (QUOTE *TIMES))) MACRO)

(DEFPROP QUOTIENT (LAMBDA (L) (*EXPAND L (QUOTE *QUO))) MACRO)

(DEFPROP LESSP
 (LAMBDA (L)
  (LIST	(QUOTE *LESS)
	(*EXPAND1 (CDR (REVERSE (CDR L)))
		  (QUOTE (LAMBDA (X Y)
				 (COND ((AND X (*LESS X Y)) Y)))))
	(CAR (LAST L))))
 MACRO)

(DEFPROP GREATERP
 (LAMBDA (L)
  (LIST	(QUOTE *GREAT)
	(*EXPAND1 (CDR (REVERSE (CDR L)))
		  (QUOTE (LAMBDA (X Y)
				 (COND ((AND X (*GREAT X Y)) Y)))))
	(CAR (LAST L))))
 MACRO)

(DEFPROP %DEVP
	 (LAMBDA (X)
		 (OR (EQ (CAR (LAST (EXPLODE X))) (QUOTE :))
		     (AND (NOT (ATOM X)) (NOT (ATOM (CDR X))))))
	 EXPR)

(DE %READCHAN (%CHAN %TALK)
	      (PROG (%OLDCHAN %SEXPR)
		    (SETQ %OLDCHAN (INC %CHAN NIL))
	       LOOP (SETQ %SEXPR (ERRSET (READ)))
		    (COND ((EQ (CAR %SEXPR) (QUOTE COMMENT))
			   (PROG (%XCH)
			    A	 (SETQ %XCH (READCH))
				 (AND (EQ %XCH (QUOTE ;)) (RETURN))
				 (GO A))
			   (GO LOOP)))
		    (COND ((ATOM %SEXPR) (GO END)))
		    (SETQ %SEXPR (EVAL (CAR %SEXPR)))
		    (COND (%TALK (PRINT %SEXPR)))
		    (GO LOOP)
	       END  (INC %OLDCHAN T)
		    (RETURN NIL)))

(DE %READAFILE (%DEV %FNAM %TALK)
 (%READCHAN (EVAL (LIST (QUOTE INPUT) (GENSYM) %DEV %FNAM)) %TALK))

(DE READIN (%DEV %FLIST %TALK)
    (PROG NIL
     LOOP (COND	((NULL %FLIST) (RETURN (QUOTE FINISHED-LOADING)))
		((%DEVP (CAR %FLIST)) (SETQ %DEV (CAR %FLIST))
				      (SETQ %FLIST (CDR %FLIST))
				      (GO LOOP)))
	  (%READAFILE %DEV (CAR %FLIST) %TALK)
	  (SETQ %FLIST (CDR %FLIST))
	  (GO LOOP)))

(DF DSKIN (%L) (READIN (QUOTE DSK:) %L T))

(DF SYSIN (%L) (READIN (QUOTE SYS:) %L NIL))

(DEFPROP PUTSYM
 (LAMBDA (L)
  (MAPCAR (FUNCTION (LAMBDA (X)
		     (COND ((ATOM X) (*PUTSYM X X))
			   (T (*PUTSYM (CAR X) (EVAL (CADR X)))))))
	  L))
 FEXPR)

(DEFPROP GETSYM
 (LAMBDA (L)
  (MAPCAR
   (FUNCTION (LAMBDA (X)
	      (PROG (V)
		    (SETQ V (*GETSYM X))
		    (COND (V (PUTPROP X (NUMVAL V) (CAR L)))
			  (T (PRINT (CONS X
					  (QUOTE (NOT IN
						      SYMBOL
						      TABLE))))))
		    (RETURN V))))
   (CDR L)))
 FEXPR)

(DF BREAK (%LL%)
	  (PROG (%EX% %ICH% %OCH%)
		(SETQ %ICH% (INC NIL NIL))
		(SETQ %OCH% (OUTC NIL NIL))
		(PRINT (CONS (QUOTE *BREAK*) (CAR %LL%)))
	   LOOP	(TERPRI)
		(SETQ %EX% (ERRSET (READ)))
		(COND ((ATOM %EX%) (GO LOOP)))
		(COND ((EQ (CAR %EX%) *BPROCEED*) (GO END)))
		(ERRSET (PRIN1 (EVAL (CAR %EX%))))
		(GO LOOP)
	   END	(INC %ICH% NIL)
		(OUTC %OCH% NIL)
		(RETURN (EVAL (CADR %LL%)))))

(SETQ *BPROCEED* (QUOTE P))

(PROG (EX)
      (SETQ EX (QUOTE (LAMBDA (L)
		       (PROG2 (SYSIN LAP)
			      (LIST (QUOTE QUOTE) (EVAL L))))))
      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
	    (QUOTE (DEFSYM LAP OPS))))

(PROG (EX)
      (SETQ EX (QUOTE (LAMBDA (L)
		       (PROG2 (SYSIN (SOSLNK . LAP))
			      (LIST (QUOTE QUOTE) (EVAL L))))))
      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
	    (QUOTE (EDFUN FILEIN))))

(PROG (EX)
      (SETQ EX (QUOTE (LAMBDA (L)
		       (PROG2 (SYSIN TRACE)
			      (LIST (QUOTE QUOTE) (EVAL L))))))
      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
	    (QUOTE (TRACE UNTRACE
			  TRACET
			  UNTRACET
			  SLST
			  UNSLST
			  RESET))))

(DF COMMENT (L) NIL)

(DF DECLARE (L) NIL)

(SETQ EIGHT (ADD1 7))

(SETQ TEN (PLUS 2 EIGHT))

(DE OCTAL NIL (SETQ BASE (SETQ IBASE EIGHT)))

(DE DECIMAL NIL (SETQ BASE (SETQ IBASE TEN)))

(COND ((NULL (ERRSET (INPUT INITCHAN DSK: (LISP . INI)) NIL)))
      (T (%READCHAN (QUOTE INITCHAN) NIL)))

(PROG NIL (INC NIL T) (OUTC NIL T) (EXCISE) (CSYM G0000) (ERR))